home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Caml Light 0.61 / Source / src / lib / queue.ml < prev    next >
Encoding:
Text File  |  1993-09-24  |  1.1 KB  |  72 lines  |  [TEXT/MPS ]
  1. #open "int";;
  2. #open "ref";;
  3. #open "exc";;
  4. #open "queue";;
  5.  
  6. type 'a queue_cell =
  7.     Nil
  8.   | Cons of 'a * 'a queue_cell ref
  9. ;;
  10.  
  11. type 'a t =
  12.   { mutable head: 'a queue_cell;
  13.     mutable tail: 'a queue_cell }
  14. ;;
  15.  
  16. let new () =
  17.   { head = Nil; tail = Nil }
  18. ;;
  19.  
  20. let clear q =
  21.   q.head <- Nil; q.tail <- Nil
  22. ;;
  23.  
  24. let add x = function
  25.     { head = Nil as h; tail = Nil as t } ->
  26.       let c = Cons(x, ref Nil) in
  27.         h <- c; t <- c
  28.   | { tail = Cons(_, ref newtail) as oldtail } ->
  29.       let c = Cons(x, ref Nil) in
  30.         newtail <- c; oldtail <- c
  31. ;;
  32.  
  33. let peek q =
  34.   match q.head with
  35.     Nil ->
  36.       raise Empty
  37.   | Cons(x, ref rest) ->
  38.       x
  39. ;;
  40.  
  41.  
  42. let take q =
  43.   match q.head with
  44.     Nil ->
  45.       raise Empty
  46.   | Cons(x, ref rest) ->
  47.       q.head <- rest;
  48.       begin match rest with
  49.         Nil -> q.tail <- Nil
  50.       |  _  -> ()
  51.       end;
  52.       x
  53. ;;
  54.  
  55. let rec length_aux = function
  56.     Nil -> 0
  57.   | Cons(_, ref rest) -> succ (length_aux rest)
  58. ;;
  59.  
  60. let length q = length_aux q.head
  61. ;;
  62.  
  63. let rec iter_aux f = function
  64.     Nil ->
  65.       ()
  66.   | Cons(x, ref rest) ->
  67.       f x; iter_aux f rest
  68. ;;
  69.  
  70. let iter f q = iter_aux f q.head
  71. ;;
  72.